home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / PASCMP / PASCMPLX.ASM < prev    next >
Encoding:
Assembly Source File  |  1994-06-29  |  23.4 KB  |  964 lines
  1. TITLE PasCmplx
  2. ;Complex mathematics unit for Borland Pascal
  3. ;(c)1994 by Alex Klimovitski
  4. ;
  5. ;Assembler routines for PASCMPLX.PAS Borland Pascal Unit.
  6. ;
  7. ;* All routines return complex or double values in register ST
  8. ;    of numeric coprocessor.
  9. ;
  10. ;* All routines don't left anything else in the 80x87 stack.
  11. ;
  12. ;* They use maximally 6 80x87 registers (ST(0)..ST(5))
  13. ;
  14. ;* All complex parameters must be in packed complex format as defined
  15. ;    below.
  16. ;
  17. ;* All complex values are returned in packed complex format.
  18. ;
  19. ;* NOTE: to use this unit with 8087 coprocessor,
  20. ;    replace "P286" instructions with "P8086",
  21. ;    set cxx87Min (below) to 1 end recompile the unit.
  22. ;
  23. ;* Complex number format in 80x87:
  24. ;          msb                         lsb
  25. ;          +--+--+--+--+--+--+--+--+--+--+
  26. ; ST(i):   |         I m - p a r t       |
  27. ;          +--+--+--+--+--+--+--+--+--+--+
  28. ; ST(i+1): |         R e - p a r t       |
  29. ;          +--+--+--+--+--+--+--+--+--+--+
  30. ;
  31. ;* Packed complex number format in 80x87:
  32. ;          msb                         lsb
  33. ;          +--+--+--+--+--+--+--+--+--+--+
  34. ; ST(i):   |    Im-part   |    Re-part   |
  35. ;          +--+--+--+--+--+--+--+--+--+--+
  36. ;
  37. ;* Packed complex number format in memory:
  38. ;          msb                   lsb
  39. ;          +--+--+--+--+--+--+--+--+
  40. ;          |  Im-part  |  Re-part  |
  41. ;          +--+--+--+--+--+--+--+--+
  42.  
  43. MODEL LARGE,PASCAL
  44.  
  45. LOCALS
  46.  
  47. PUBLIC CTest87, CInit,\
  48.   Cmplx, Conjug, CReal, CImag, Conjug,\
  49.   CAdd, CSub, CMul, CDiv, C1Z,\
  50.   CAbs, CArg, _CExp2, _CExp3, _CExpR, CExp, CLn,\
  51.   CPow, CIPow, CRPow,\
  52.   CSinR, CCosR, CSinCosR,\
  53.   CTest, CTestR, CCheck, CCheckR
  54.  
  55. EXTRN Sin, Cos            ;used only for 80287
  56.  
  57.  
  58. DATASEG
  59.  
  60. EXTRN Cj:QWORD, C1:QWORD
  61.         DB 'PasCmplxMath (c)1994 Alex K.'
  62.  
  63. ;80x87 register state codes
  64. ZERM    EQU 0             ;-0
  65. ZERP    EQU 1             ;+0
  66. NORM    EQU 2             ;normalized < 0
  67. NORP    EQU 3             ;normalized > 0
  68. INFM    EQU 4             ;-infinity
  69. INFP    EQU 5             ;+infinity
  70. UNNM    EQU 6             ;-unnormalized
  71. UNNP    EQU 7             ;+unnormalized
  72. DENM    EQU 8             ;-denormalized
  73. DENP    EQU 9             ;+denormalized
  74. NANM    EQU 10            ;-not-a-number
  75. NANP    EQU 11            ;+not-a-number
  76. EMPT    EQU 12            ;empty
  77.  
  78. OK87    EQU 03h           ;80x87 register Ok mask
  79.  
  80. ;80x87 register state table
  81. cxCTable DB UNNP, NANP, UNNM, NANM
  82.          DB NORP, INFP, NORM, INFM
  83.          DB ZERP, EMPT, ZERM, EMPT
  84.          DB DENP, EMPT, DENM, EMPT
  85.  
  86.  
  87. UDATASEG
  88.  
  89. cxx87   DW ?              ;80x87 flag: 0=none, 1=8087, 2=80287, 3=80387 and higher
  90. cxx87Min EQU 2            ;minimal 80x87 required
  91. cxPI2   DQ ?              ;pi/2
  92. cxPI4   DQ ?              ;pi/4
  93.  
  94. CODESEG
  95.  
  96. cxINIT MACRO              ;initialize 80x87
  97.         FINIT
  98. ENDM
  99.  
  100. cxLD4 MACRO Z             ;packed complex Z -> complex in 80x87
  101.         FLD DWORD PTR Z
  102.         FLD DWORD PTR Z + 4
  103. ENDM
  104.  
  105. cxSTP4 MACRO Z            ;complex in 80x87 -> packed complex Z
  106.         FSTP DWORD PTR Z + 4
  107.         FSTP DWORD PTR Z
  108. ENDM
  109.  
  110. cxCONV4 MACRO Z           ;complex in 80x87 -> packed complex in 80x87
  111.         cxSTP4 Z
  112.         FLD QWORD PTR Z
  113. ENDM
  114.  
  115. cxCONV8 MACRO Z           ;packed complex in 80x87 -> complex in 80x87
  116.         FSTP QWORD PTR Z
  117.         cxLD4 Z
  118. ENDM
  119.  
  120. cxTST MACRO               ;compare real in ST(0) with 0
  121.         FTST
  122.         FSTSW AX
  123.         SAHF
  124. ENDM
  125.  
  126. cxCMP MACRO               ;compare reals in ST(0) and ST(1)
  127.         FCOM
  128.         FSTSW AX
  129.         SAHF
  130. ENDM
  131.  
  132. cxLDj MACRO               ;load complex i
  133.         FLDZ
  134.         FLD1
  135. ENDM
  136.  
  137. cxLD1 MACRO               ;load complex 1
  138.         FLD1
  139.         FLDZ
  140. ENDM
  141.  
  142. cxLD0 MACRO               ;load complex 0
  143.         FLDZ
  144.         FLDZ
  145. ENDM
  146.  
  147. cxCNJG MACRO              ;z = conjug z
  148.         cxTST
  149.         JZ @@1
  150.         FCHS
  151. @@1:
  152. ENDM
  153.  
  154. cxADD MACRO               ;z + p
  155.         FADDP ST(2),ST
  156.         FADDP ST(2),ST
  157. ENDM
  158.  
  159. cxSUB MACRO               ;z - p
  160.         FSUBP ST(2),ST
  161.         FSUBP ST(2),ST
  162. ENDM
  163.  
  164. cxMUL MACRO               ;z * p: Re = ac - bd, Im = ad + bc
  165.         FLD ST            ;b
  166.         FLD ST(2)         ;a
  167.         FMUL ST,ST(5)     ;ac
  168.         FXCH
  169.         FMUL ST,ST(4)     ;bd
  170.         FSUB              ;ac - bd = Re
  171.  
  172.         FXCH ST(2)        ;a
  173.         FMULP ST(3),ST    ;(3) = ad; b
  174.         FMULP ST(3),ST    ;(3) = bc; Re
  175.         FXCH ST(2)        ;bc
  176.         FADD              ;ad + bc = Im
  177. ENDM
  178.  
  179. cxDIV MACRO               ;z/p: Re = (a + d/c * b) / (c + d/c * d),
  180. LOCAL @@1, @@2            ;     Im = (b - d/c * a) / (c + d/c * d)
  181.         FLD ST(1)         ;c
  182.         cxTST
  183.         JNZ @@1
  184.                           ;c=0
  185.         FSTP ST           ;d
  186.         FDIV ST(3),ST     ;(3) = a/d
  187.         FDIVP ST(2),ST    ;(1) = b/d; c
  188.         FSTP ST           ;b/d
  189.         FXCH              ;a/d
  190.         FCHS              ;-a/d
  191.         JMP SHORT @@2
  192. @@1:
  193.         FDIVR ST,ST(1)    ;d/c
  194.         FMUL ST(1),ST     ;(1) = d * d/c; d/c
  195.         FLD ST            ;d/c
  196.  
  197.         FMUL ST,ST(5)     ;d/c * a
  198.         FXCH              ;d/c
  199.         FMUL ST,ST(4)     ;d/c * b
  200.         FADDP ST(5),ST    ;(4) = a + d/c * b; d/c * a
  201.         FSUBP ST(3),ST    ;(2) = b - d/c * a; d/c * d
  202.         FADD              ;c + d/c * d
  203.         FDIV ST(2),ST     ;(2) = (a + d/c * b) / (c + d/c * d)
  204.         FDIV
  205. @@2:
  206. ENDM
  207.  
  208. cxABS MACRO               ;abs(z)
  209.         FMUL ST,ST
  210.         FXCH
  211.         FMUL ST,ST
  212.         FADD
  213.         FSQRT
  214. ENDM
  215.  
  216. cx1Z MACRO                ;1/z
  217.         FLD ST(1)
  218.         FLD ST(1)
  219.         cxABS
  220.         FDIV ST(2),ST
  221.         FDIV
  222. ENDM
  223.  
  224. cxARG MACRO               ;arg z
  225. LOCAL @@1, @@2, @@3, @@4, @@aGE0, @@bGE0, @@00, @@aLTb, @@aGTb, @@bWasLT0
  226.         cxTST             ;b >= 0?
  227.         JGE @@bGE0
  228.         FCHS              ;b := -b
  229.         MOV BL,1
  230.         JMP SHORT @@1
  231. @@bGE0:
  232.         XOR BL,BL
  233. @@1:                      ;a
  234.         FXCH              ;a >= 0?
  235.         cxTST
  236.         JGE @@aGE0
  237.         FCHS              ;a := - a;
  238.         MOV DL,1
  239.         JMP SHORT @@2
  240. @@aGE0:
  241.         XOR DL,DL
  242. @@2:
  243.         cxCMP             ;a > b?
  244.         JL @@aLTb
  245.         JG @@aGTb
  246. ;@@aEQb:
  247.         cxTST
  248.         FCOMPP
  249.         JZ @@00
  250.         FLD cxPI4
  251.         JMP SHORT @@3
  252. @@00:
  253.         FLDZ
  254.         JMP SHORT @@4
  255. @@aLTb:
  256.         FXCH
  257.         FPATAN
  258.         FLD QWORD PTR cxPI2
  259.         FSUBR
  260.         JMP SHORT @@3
  261. @@aGTb:
  262.         FPATAN
  263. @@3:
  264.         AND DL,DL         ;a >= 0?
  265.         JZ @@4            ;yes
  266.  
  267. ;@@aWasLT0:
  268.         FLDPI
  269.         AND BL,BL         ;b >= 0?
  270.         JNZ @@bWasLT0     ;no
  271. ;@@bWasGE0:
  272.         FSUBR
  273.         JMP SHORT @@4
  274. @@bWasLT0:
  275.         FSUB
  276. @@4:
  277. ENDM
  278.  
  279. cx2X MACRO                ;2^x
  280. LOCAL @@1, @@2, @@fGE0, @@iEQ0
  281.         FLD ST
  282.         FRNDINT           ;i = [x]
  283.         FSUB ST(1),ST     ;(1) = f = x - i
  284.         FXCH
  285.  
  286.         cxTST
  287.         JGE @@fGE0
  288. ;@@fLT0:
  289.         FCHS
  290.         F2XM1
  291.         FLD ST
  292.         FLD1
  293.         FADD
  294.         FDIV
  295.         FCHS
  296.         JMP SHORT @@1
  297. @@fGE0:
  298.         F2XM1
  299. @@1:
  300.         FLD1
  301.         FADD              ;2^f
  302.  
  303.         FXCH              ;i
  304.         cxTST
  305.         JZ @@iEQ0
  306.         FXCH
  307.         FSCALE
  308.         FXCH              ;i
  309. @@iEQ0:
  310.         FSTP ST           ;2^x
  311. @@2:
  312. ENDM
  313.  
  314. cxEXPR MACRO              ;e^x
  315.         FLDL2E
  316.         FMUL
  317.         cx2X
  318. ENDM
  319.  
  320. cxPOWR MACRO              ;x^y
  321.         FYL2X
  322.         cx2X
  323. ENDM
  324.  
  325. cxEXP3 MACRO              ;e^z
  326.         FSINCOS           ;cos b
  327.         FXCH ST(2)        ;a
  328.         cxEXPR            ;e^a
  329.         FMUL ST(2),ST
  330.         FMUL
  331. ENDM
  332.  
  333. cxLNR MACRO               ;ln x
  334.         FLDLN2
  335.         FXCH
  336.         FYL2X
  337. ENDM
  338.  
  339. cxEXAM MACRO
  340. LOCAL @@1, @@MaskC3, @@MaskST1, @@MaskC
  341. @@MaskC3  EQU 40h
  342. @@MaskST0 EQU 08h
  343. @@MaskC   EQU 0fh
  344.         FXAM
  345.         FSTSW AX
  346.         AND AH,NOT @@MaskST0
  347.         TEST AH,@@MaskC3
  348.         JZ @@1
  349.         OR AH,@@MaskST0
  350. @@1:
  351.         AND AH,@@MaskC
  352.         MOV AL,AH
  353.         LEA BX,cxCTable
  354.         XLAT
  355. ENDM
  356.  
  357. P8086
  358.  
  359. ;----------------------------------------------------------------------
  360. ;function CTest87: Integer;
  361. ;checks numeric coprocessor
  362. ;returns AX = 80x87 flag as above
  363. ;----------------------------------------------------------------------
  364. CTest87 PROC PASCAL FAR
  365.         LOCAL Tmp
  366.         XOR AX,AX         ;indicate no 80x87
  367.         FNINIT            ;initialize 80x87
  368.         MOV Tmp,0         ;clear status word
  369.         FNSTCW Tmp        ;store status word
  370.         FWAIT
  371.         AND Tmp,0F3FH     ;mask out unwanted bits
  372.         CMP Tmp,033FH     ;compare to 80x87 default
  373.         JNE @@End
  374.         NOT Tmp
  375.         FLDCW Tmp
  376.         FSTCW Tmp
  377.         FWAIT
  378.         AND Tmp,0F3FH     ;mask out unwanted bits
  379.         CMP Tmp,0C00H     ;compare to 80x87 default
  380.         JNE @@End
  381.  
  382.         PUSH SP           ;check 8088/8086
  383.         POP AX
  384.         CMP AX,SP         ;not equal on 8088/8086
  385.         MOV AX,1          ;indicate 8087
  386.         JNE @@End
  387.  
  388.         FINIT             ;initialize
  389.  
  390.         FLD1              ;generate +INF
  391.         FLDZ
  392.         FDIV
  393.         FLD ST(0)         ;generate -INF
  394.         FCHS
  395.         FCOMPP            ;compare infinities
  396.         FSTSW Tmp         ;store status
  397.         FWAIT
  398.         MOV AX,Tmp        ;status to flags
  399.         SAHF
  400.         JNE @@387
  401.         MOV AX,2          ;indicate 80287
  402.         JMP SHORT @@End
  403. @@387:  MOV AX,3          ;indicate 80387
  404. @@End:
  405.         RET
  406. CTest87 ENDP
  407.  
  408. ;----------------------------------------------------------------------
  409. ;function CInit: Integer;
  410. ;initializes complex math unit
  411. ;returns AX = 0 if Ok, AX <> 0 else
  412. ;----------------------------------------------------------------------
  413. CInit PROC PASCAL FAR
  414. LOCAL @@cx2:WORD
  415.         CALL CTest87 PASCAL
  416.         MOV cxx87,AX
  417.         CMP AX,cxx87Min
  418.         JGE @@Ok
  419.         MOV AX,1
  420.         JMP SHORT @@End
  421. @@Ok:
  422.         cxInit
  423.  
  424.         FLDPI
  425.         MOV @@cx2,2
  426.         FILD WORD PTR @@cx2
  427.         FDIV
  428.         FST QWORD PTR cxPI2
  429.         FILD WORD PTR @@cx2
  430.         FDIV
  431.         FSTP QWORD PTR cxPI4
  432.  
  433.         cxLDj
  434.         cxSTP4 Cj
  435.  
  436.         cxLD1
  437.         cxSTP4 C1
  438.  
  439.         XOR AX,AX
  440. @@End:
  441.         RET
  442. CInit ENDP
  443.  
  444.  
  445. P286
  446.  
  447. ;----------------------------------------------------------------------
  448. ;function Cmplx(A, B: Double): Complex;
  449. ;makes complex from a and b
  450. ;returns ST = a + i * b
  451. ;----------------------------------------------------------------------
  452. Cmplx PROC PASCAL FAR     ;z := a + i * b
  453. ARG A:QWORD, B:QWORD
  454.         FLD QWORD PTR A
  455.         FLD QWORD PTR B
  456.         cxCONV4 B
  457.         RET
  458. Cmplx ENDP
  459.  
  460. ;----------------------------------------------------------------------
  461. ;function CReal(Z: Complex): Double;
  462. ;real part from z = a + i * b
  463. ;returns ST = a
  464. ;----------------------------------------------------------------------
  465. CReal PROC PASCAL FAR     ;a
  466. ARG Z:QWORD
  467.         FLD DWORD PTR Z
  468.         RET
  469. CReal ENDP
  470.  
  471. ;----------------------------------------------------------------------
  472. ;function CImag(Z: Complex): Double;
  473. ;imaginary part from z = a + i * b
  474. ;returns ST = b
  475. ;----------------------------------------------------------------------
  476. CImag PROC PASCAL FAR     ;b
  477. ARG Z:QWORD
  478.         FLD DWORD PTR Z + 4
  479.         RET
  480. CImag ENDP
  481.  
  482. ;----------------------------------------------------------------------
  483. ;function Conjug(Z: Complex): Complex;
  484. ;conjugate complex for z = a + i * b
  485. ;returns ST = a - i * b
  486. ;----------------------------------------------------------------------
  487. Conjug PROC PASCAL FAR    ;a - i * b
  488. ARG Z:QWORD
  489.         cxLD4 Z
  490.         cxCNJG
  491.         cxCONV4 Z
  492.         RET
  493. Conjug ENDP
  494.  
  495. ;----------------------------------------------------------------------
  496. ;function CAdd(Z, P: Complex): Complex;
  497. ;adds z = a + i * b and p = c + i * d
  498. ;returns ST = z + p
  499. ;----------------------------------------------------------------------
  500. CAdd PROC PASCAL FAR      ;z + p
  501. ARG Z:QWORD, P:QWORD
  502.         cxLD4 Z
  503.         cxLD4 P
  504.         cxADD
  505.         cxCONV4 Z
  506.         RET
  507. CAdd ENDP
  508.  
  509. ;----------------------------------------------------------------------
  510. ;function CSub(Z, P: Complex): Complex;
  511. ;subtracts p = c + i * d from z = a + i * b
  512. ;returns ST = z - p
  513. ;----------------------------------------------------------------------
  514. CSub PROC PASCAL FAR      ;z - p
  515. ARG Z:QWORD, P:QWORD
  516.         cxLD4 Z
  517.         cxLD4 P
  518.         cxSUB
  519.         cxCONV4 Z
  520.         RET
  521. CSub ENDP
  522.  
  523. ;----------------------------------------------------------------------
  524. ;function CMul(Z, P: Complex): Complex;
  525. ;multiplies z = a + i * b and p = c + i * d
  526. ;returns ST = z * p
  527. ;----------------------------------------------------------------------
  528. CMul PROC PASCAL FAR      ;z * p
  529. ARG Z:QWORD, P:QWORD
  530.         cxLD4 P
  531.         cxLD4 Z
  532.         cxMUL
  533.         cxCONV4 Z
  534.         RET
  535. CMul ENDP
  536.  
  537. ;----------------------------------------------------------------------
  538. ;function CDiv(Z, P: Complex): Complex;
  539. ;divides z = a + i * b by p = c + i * d
  540. ;returns ST = z / p
  541. ;----------------------------------------------------------------------
  542. CDiv PROC PASCAL FAR      ;z / p
  543. ARG Z:QWORD, P:QWORD
  544.         cxLD4 Z
  545.         cxLD4 P
  546.         cxDIV
  547.         cxCONV4 Z
  548.         RET
  549. CDiv ENDP
  550.  
  551. ;----------------------------------------------------------------------
  552. ;function C1Z(Z: Complex): Complex;
  553. ;divides 1 by z = a + i * b
  554. ;returns ST = 1 / z
  555. ;----------------------------------------------------------------------
  556. C1Z PROC PASCAL FAR    ;a - i * b
  557. ARG Z:QWORD
  558.         cxLD4 Z
  559.         cx1Z
  560.         cxCONV4 Z
  561.         RET
  562. C1Z ENDP
  563.  
  564. ;----------------------------------------------------------------------
  565. ;function CAbs(Z: Complex): Complex;
  566. ;absolute value of complex z = a + i * b
  567. ;returns ST = abs(z) = a^2 + b^2
  568. ;----------------------------------------------------------------------
  569. CAbs PROC PASCAL FAR      ;abs(z)
  570. ARG Z:QWORD
  571.         cxLD4 Z
  572.         cxABS
  573.         RET
  574. CAbs ENDP
  575.  
  576. ;----------------------------------------------------------------------
  577. ;function CArg(Z: Complex): Complex;
  578. ;argument of complex z = a + i * b
  579. ;returns ST = arg(z)
  580. ;----------------------------------------------------------------------
  581. CArg PROC PASCAL FAR      ;arg(z)
  582. ARG Z:QWORD
  583.         cxLD4 Z
  584.         cxARG
  585.         RET
  586. CArg ENDP
  587.  
  588. ;----------------------------------------------------------------------
  589. ;function _CExpR(R: Double): Double;
  590. ;exponential of real r
  591. ;returns ST = e^r
  592. ;----------------------------------------------------------------------
  593. _CExpR PROC PASCAL NEAR   ;e^r
  594. ARG R:QWORD
  595.         FLD QWORD PTR R
  596.         cxEXPR
  597.         RET
  598. _CExpR ENDP
  599.  
  600. ;----------------------------------------------------------------------
  601. ;function _CExp2(Z: Complex): Complex;
  602. ;exponential of complex z for 80287
  603. ;returns ST = e^z = e^a * (cos(b) + i * sin(b))
  604. ;----------------------------------------------------------------------
  605. _CExp2 PROC PASCAL NEAR   ;e^z
  606. ARG Z:QWORD
  607. LOCAL A:QWORD,B:QWORD,SinB:QWORD
  608.         cxLD4 Z
  609.         FSTP B
  610.         FSTP A
  611.         CALL NEAR PTR Sin PASCAL, DWORD PTR B[4] DWORD PTR B
  612.         FSTP QWORD PTR SinB
  613.         CALL NEAR PTR Cos PASCAL, DWORD PTR B[4] DWORD PTR B
  614.         FLD QWORD PTR SinB
  615.         FLD QWORD PTR A
  616.         cxEXPR
  617.         FMUL ST(2),ST
  618.         FMUL
  619.         cxCONV4 Z
  620.         RET
  621. _CExp2 ENDP
  622.  
  623. ;----------------------------------------------------------------------
  624. ;function _CExp3(Z: Complex): Complex;
  625. ;exponential of complex z for 80387
  626. ;returns ST = e^z = e^a * (cos(b) + i * sin(b))
  627. ;----------------------------------------------------------------------
  628. P386
  629. _CExp3 PROC PASCAL NEAR   ;e^z
  630. ARG Z:QWORD
  631.         cxLD4 Z
  632.         cxEXP3
  633.         cxCONV4 Z
  634.         RET
  635. _CExp3 ENDP
  636.  
  637. ;----------------------------------------------------------------------
  638. ;function CExp(Z: Complex): Complex;
  639. ;exponential of complex z
  640. ;returns ST = e^z = e^a * (cos(b) + i * sin(b))
  641. ;----------------------------------------------------------------------
  642. P386
  643. CExp PROC PASCAL FAR      ;e^z
  644. ARG Z:QWORD
  645.         CMP cxx87,2
  646.         JLE @@287
  647.         cxLD4 Z
  648.         cxEXP3
  649.         cxCONV4 Z
  650.         RET
  651. @@287:
  652.         CALL NEAR PTR _CExp2 PASCAL, DWORD PTR Z[4] DWORD PTR Z
  653.         RET
  654. CExp ENDP
  655.  
  656. ;----------------------------------------------------------------------
  657. ;function CLn(Z: Complex): Complex;
  658. ;natural logarithm of complex z
  659. ;returns ST = ln(z) = ln(abs(z)) + i * arg(z)
  660. ;----------------------------------------------------------------------
  661. P286
  662. CLn PROC PASCAL FAR       ;ln z
  663. ARG Z:QWORD
  664.         cxLD4 Z
  665.         cxABS
  666.         cxLNR
  667.         cxLD4 Z
  668.         cxARG
  669.         cxCONV4 Z
  670.         RET
  671. CLn ENDP
  672.  
  673. ;----------------------------------------------------------------------
  674. ;function CPow(Z, P: Complex): Complex;
  675. ;complex z in complex power p
  676. ;returns ST = z^p = e^(p * ln(z))
  677. ;----------------------------------------------------------------------
  678. P386
  679. CPow PROC PASCAL FAR       ;z^p
  680. ARG Z:QWORD, P:QWORD
  681.         cxLD4 Z
  682.         cxABS
  683.         cxLNR
  684.         cxLD4 Z
  685.         cxARG
  686.  
  687.         cxLD4 P
  688.         cxMUL
  689.  
  690.         CMP cxx87,2
  691.         JLE @@287
  692.         cxEXP3
  693.         cxCONV4 Z
  694.         RET
  695. @@287:
  696.         cxSTP4 Z
  697.         CALL NEAR PTR _CExp2 PASCAL, DWORD PTR Z[4] DWORD PTR Z
  698.         RET
  699. CPow ENDP
  700.  
  701. ;----------------------------------------------------------------------
  702. ;function CIPow(Z: Complex; N: Integer): Complex;
  703. ;complex z in integer power n
  704. ;returns ST = z^n
  705. ;performs consequent multiplication if abs(n) <= MaxMult,
  706. ;  else uses z^n = abs(z)^n * (cos(n*arg(z)) + i * sin(n*arg(z)))
  707. ;----------------------------------------------------------------------
  708. P386
  709. CIPow PROC PASCAL FAR       ;z^n
  710. ARG Z:QWORD, N:WORD
  711. LOCAL T:QWORD, SinT:QWORD
  712. @@MaxMult EQU 16
  713.  
  714.         MOV CX,N
  715.         XOR DL,DL
  716.         CMP CX,0
  717.         JG @@1
  718.         JL @@NLT0
  719.         cxLD1
  720.         JMP SHORT @@3
  721. @@NLT0:
  722.         NEG CX
  723.         MOV N,CX
  724.         MOV DL,1
  725. @@1:
  726.         CMP CX,@@MaxMult
  727.         JG @@AbsArg
  728.         cxLD4 Z
  729.         DEC CX
  730.         AND CX,CX
  731.         JZ @@2
  732. @@Mul:
  733.         cxLD4 Z
  734.         cxMUL
  735.         LOOP @@Mul
  736. @@2:
  737.         AND DL,DL
  738.         JZ @@3
  739.         cx1Z
  740. @@3:
  741.         cxCONV4 Z
  742.         RET
  743.  
  744. @@AbsArg:
  745.         cxLD4 Z
  746.         cxARG
  747.         FILD WORD PTR N
  748.         FMUL
  749.         CMP cxx87,2
  750.         JLE @@287
  751.         FSINCOS
  752.         FXCH
  753.         JMP SHORT @@4
  754. @@287:
  755.         FSTP T
  756.         CALL NEAR PTR Sin PASCAL, DWORD PTR T[4] DWORD PTR T
  757.         FSTP SinT
  758.         CALL NEAR PTR Cos PASCAL, DWORD PTR T[4] DWORD PTR T
  759.         FLD SinT
  760. @@4:
  761.         FILD WORD PTR N
  762.         cxLD4 Z
  763.         cxABS
  764.         cxPOWR            ;R^n
  765.  
  766.         FMUL ST(2),ST
  767.         FMUL
  768.         JMP @@2
  769. CIPow ENDP
  770.  
  771. ;----------------------------------------------------------------------
  772. ;function CRPow(Z: Complex; R: Double): Complex;
  773. ;complex z in real power r
  774. ;returns ST = z^r = abs(z)^r * (cos(r*arg(z)) + i * sin(r*arg(z)))
  775. ;----------------------------------------------------------------------
  776. P386
  777. CRPow PROC PASCAL FAR       ;z^r
  778. ARG Z:QWORD, R:QWORD
  779. LOCAL T:QWORD, CosT:QWORD
  780.  
  781.         FLD R
  782.         XOR DL,DL
  783.         cxTST
  784.         JG @@1
  785.         JL @@RLT0
  786.         FSTP ST
  787.         JMP @@3
  788. @@RLT0:
  789.         FCHS
  790.         MOV DL,1
  791. @@1:
  792.         cxLD4 Z
  793.         cxARG
  794.         FLD ST(1)         ;r
  795.         FMUL
  796.         CMP cxx87,2
  797.         JLE @@287
  798.         FSINCOS
  799.         JMP SHORT @@4
  800. @@287:
  801.         FSTP T
  802.         CALL NEAR PTR Cos PASCAL, DWORD PTR T[4] DWORD PTR T
  803.         FSTP CosT
  804.         CALL NEAR PTR Sin PASCAL, DWORD PTR T[4] DWORD PTR T
  805.         FLD CosT
  806. @@4:
  807.         FXCH ST(2)        ;r
  808.         cxLD4 Z
  809.         cxABS
  810.         cxPOWR            ;R^r
  811.  
  812.         FMUL ST(2),ST
  813.         FMUL
  814.  
  815.         AND DL,DL
  816.         JZ @@3
  817.         cx1Z
  818. @@3:
  819.         cxCONV4 Z
  820.         RET
  821. CRPow ENDP
  822.  
  823. ;----------------------------------------------------------------------
  824. ;function CSinR(R: Double): Double;
  825. ;sine of real r
  826. ;returns ST = sin(r)
  827. ;----------------------------------------------------------------------
  828. P386
  829. CSinR PROC PASCAL FAR   ;sin(r)
  830. ARG R:QWORD
  831.         CMP cxx87,2
  832.         JLE @@287
  833.         FLD QWORD PTR R
  834.         FSIN
  835.         RET
  836. @@287:
  837.         CALL NEAR PTR Sin PASCAL, DWORD PTR R[4] DWORD PTR R
  838.         RET
  839. CSinR ENDP
  840.  
  841. ;----------------------------------------------------------------------
  842. ;function CCosR(R: Double): Double;
  843. ;cosine of real r
  844. ;returns ST = cos(r)
  845. ;----------------------------------------------------------------------
  846. P386
  847. CCosR PROC PASCAL FAR   ;cos(r)
  848. ARG R:QWORD
  849.         CMP cxx87,2
  850.         JLE @@287
  851.         FLD QWORD PTR R
  852.         FCOS
  853.         RET
  854. @@287:
  855.         CALL NEAR PTR Cos PASCAL, DWORD PTR R[4] DWORD PTR R
  856.         RET
  857. CCosR ENDP
  858.  
  859. ;----------------------------------------------------------------------
  860. ;function CCosR(R: Double; var S, C: Double): Double;
  861. ;sine and cosine of real r
  862. ;sets s := sin(r); c := cos(r)
  863. ;returns noting
  864. ;----------------------------------------------------------------------
  865. P386
  866. CSinCosR PROC PASCAL FAR   ;sin(r) & cos(r)
  867. ARG R:QWORD, S:DWORD, C:DWORD
  868.         CMP cxx87,2
  869.         JLE @@287
  870.         FLD QWORD PTR R
  871.         FSINCOS
  872.         LES BX,DWORD PTR C
  873.         LFS SI,DWORD PTR S
  874.         FSTP QWORD PTR ES:[BX]
  875.         FSTP QWORD PTR FS:[SI]
  876.         RET
  877. @@287:
  878.         CALL NEAR PTR Sin PASCAL, DWORD PTR R[4] DWORD PTR R
  879.         LES BX,DWORD PTR S
  880.         FSTP QWORD PTR ES:[BX]
  881.         CALL NEAR PTR Cos PASCAL, DWORD PTR R[4] DWORD PTR R
  882.         LES BX,DWORD PTR C
  883.         FSTP QWORD PTR ES:[BX]
  884.         RET
  885. CSinCosR ENDP
  886.  
  887. ;----------------------------------------------------------------------
  888. ;function CTest(Z: Complex): Word;
  889. ;tests complex z
  890. ;returns AL = state of real part, AH = state of imag. part
  891. ;this function returns 80x87 register state flags
  892. ;----------------------------------------------------------------------
  893. P286
  894. CTest PROC PASCAL FAR
  895. ARG Z:QWORD
  896.         cxLD4 Z
  897.         cxEXAM
  898.         FXCH
  899.         MOV DL,AL
  900.         cxEXAM
  901.         FCOMPP
  902.         MOV AH,DL
  903.         RET
  904. CTest ENDP
  905.  
  906. ;----------------------------------------------------------------------
  907. ;function CTestR(R: Double): Word;
  908. ;tests real r
  909. ;returns AX = state of real r
  910. ;this function returns 80x87 register state flags
  911. ;----------------------------------------------------------------------
  912. P286
  913. CTestR PROC PASCAL FAR
  914. ARG R:QWORD
  915.         FLD R
  916.         cxEXAM
  917.         FSTP ST
  918.         XOR AH,AH
  919.         RET
  920. CTestR ENDP
  921.  
  922. ;----------------------------------------------------------------------
  923. ;function CCheck(Z: Complex): Word;
  924. ;checks complex z
  925. ;returns AX <> 0 if real or imag. part invalid (not a zero and
  926. ; not a normalized number)
  927. ;----------------------------------------------------------------------
  928. P286
  929. CCheck PROC PASCAL FAR
  930. ARG Z:QWORD
  931.         FLD DWORD PTR Z
  932.         cxEXAM
  933.         AND AL,NOT OK87
  934.         JZ @@1
  935.         FSTP ST
  936.         RET
  937. @@1:
  938.         FLD DWORD PTR Z + 4
  939.         cxEXAM
  940.         AND AL,NOT OK87
  941.         JNZ @@2
  942.         XOR AX,AX
  943. @@2:
  944.         FCOMPP
  945.         RET
  946. CCheck ENDP
  947.  
  948. ;----------------------------------------------------------------------
  949. ;function CCheckR(R: Double): Word;
  950. ;tests real r
  951. ;returns AX <> 0 if real invalid (not a zero and not a normalized number)
  952. ;----------------------------------------------------------------------
  953. P286
  954. CCheckR PROC PASCAL FAR
  955. ARG R:QWORD
  956.         FLD R
  957.         cxEXAM
  958.         FSTP ST
  959.         AND AL,NOT OK87
  960.         XOR AH,AH
  961.         RET
  962. CCheckR ENDP
  963.  
  964. END